
 1000         .LIST CON
 1010  *SAVE S.SYMBOL SOURCEROR
 1020  *--------------------------------
 1030  VERSION    .EQ 1    0=1.1, 1=2.0
 1040  *--------------------------------
 1050  *   THE FOLLOWING ADDRESS SHOULD POINT
 1060  *   TO A "CPX #$06" INSTRUCTION.  IF IT
 1070  *   DOESN'T IN YOUR PARTICULAR COPY, FIND
 1080  *   THAT INSTRUCTION AND PLACE THE CORRECT
 1090  *   ADDRESS HERE.
 1100  *--------------------------------
 1110      .DO VERSION     ...V 2.0
 1120  RENUMBER .EQ $D65B       V 2.0
 1130      .ELSE           ...V 1.1
 1140  RENUMBER .EQ $D7DA       V 1.1
 1150      .FIN
 1160  *--------------------------------
 1170  PTR        .EQ $00,01
 1180  A1         .EQ $02,03
 1190  A2         .EQ $04,05
 1200  ROOT       .EQ $06,07
 1210  XSAVE      .EQ $8
 1220  CSW        .EQ $36,37
 1230  *--------------------------------
 1240  HASH.TAB   .EQ $132
 1250  WBUF       .EQ $280
 1260  *--------------------------------
 1270  PRBYTE     .EQ $FDDA
 1280  COUT       .EQ $FDED
 1290  SETVID     .EQ $FE93
 1300  *--------------------------------
 1310  *      PROGRAM POINTERS
 1320  *--------------------------------
 1330  PRG.BEG    .EQ $CA,CB
 1340  PRG.END    .EQ $4C,4D
 1350  *--------------------------------
 1360  MAKE.SOURCE.FROM.SYMBOL.TABLE
 1370         LDA #MYCOUT       GRAB THE OUTPUT HOOK
 1380         STA CSW
 1390         LDA /MYCOUT
 1400         STA CSW+1
 1410         LDA PRG.END       EMPTY THE PROGRAM AREA
 1420         STA PRG.BEG
 1430         LDA PRG.END+1
 1440         STA PRG.BEG+1
 1450  *---SCAN THROUGH HASH TABLE------
 1460         LDX #0
 1470         STX ROOT          EMPTY NUMERIC-ORDER CHAIN
 1480         STX ROOT+1
 1490  *---GET START OF NEXT CHAIN------
 1500  .1     LDA HASH.TAB+1,X
 1510         BEQ .6            ...THIS CHAIN IS EMPTY
 1520         STA PTR+1
 1530         LDA HASH.TAB,X
 1540         STA PTR
 1550         STX XSAVE
 1560  *---SEARCH FOR POSITION IN N-O CHAIN---
 1570  .2     LDA #ROOT    START SEARCH FROM BEGINNING
 1580         STA A1            OF NUMERIC-ORDER CHAIN
 1590         LDA /ROOT
 1600         STA A1+1
 1610  .3     LDA A1       PROMOTE BOTH POINTERS
 1620         STA A2            TO THE NUMERIC-ORDER CHAIN
 1630         LDA A1+1
 1640         STA A2+1
 1650         LDY #0
 1660         LDA (A1),Y
 1670         TAX
 1680         INY
 1690         LDA (A1),Y
 1700         STA A1+1
 1710         STX A1
 1720         BEQ .5
 1730  *---COMPARE A-O WITH N-O VALUE---
 1740      .DO VERSION     ...V 2.0
 1750         LDX #3       4-BYTE VALUES
 1760      .ELSE           ...V 1.1
 1770         LDX #1       2-BYTE VALUES
 1780      .FIN
 1790         SEC
 1800  .4     INY
 1810         LDA (A1),Y
 1820         SBC (PTR),Y
 1830         DEX
 1840         BPL .4
 1850         BCS .3       ...A-O VALUE < N-O VALUE
 1860  *---INSERT A-O VALUE INTO N-O CHAIN---
 1870  .5     LDY #0
 1880         LDA (PTR),Y
 1890         TAX
 1900         LDA A1
 1910         STA (PTR),Y
 1920         LDA PTR
 1930         STA (A2),Y
 1940         INY
 1950         LDA (PTR),Y
 1960         PHA
 1970         LDA A1+1
 1980         STA (PTR),Y
 1990         LDA PTR+1
 2000         STA (A2),Y
 2010         STX PTR
 2020         PLA
 2030         STA PTR+1
 2040         BNE .2       ...NOT END OF CHAIN YET
 2050  *---NEXT HASH CHAIN--------------
 2060         LDX XSAVE
 2070  .6     INX
 2080         INX
 2090         CPX #2*26    26 HASH CHAINS
 2100         BCC .1       ...STILL ANOTHER CHAIN
 2110  *--------------------------------
 2120  *   RUN THROUGH NUMERIC-ORDER CHAIN
 2130  *   AND CREATE A SOURCE LINE FOR EACH SYMBOL.
 2140  *--------------------------------
 2150         LDA ROOT+1   CHECK FOR NO CHAIN AT ALL
 2160         BEQ .17
 2170      .DO VERSION     ...V 2.0
 2180  .8     LDX #4
 2190      .ELSE           ...V 1.1
 2200  .8     LDX #2
 2210      .FIN
 2220         LDY #2
 2230  .9     LDA (ROOT),Y
 2240         PHA
 2250         INY
 2260         DEX
 2270         BPL .9
 2280         PLA
 2290         AND #$3F
 2300         TAX
 2310  .10    LDA (ROOT),Y
 2320         JSR COUT
 2330         DEX
 2340         BNE .10
 2350  *---TAB TO .EQ COLUMN------------
 2360         LDA #$81
 2370         CPY #25
 2380         BCS .11
 2390         TYA
 2400         EOR #$FF
 2410         ADC #$9A
 2420  .11    JSR MYCOUT1
 2430  *---OUTPUT ".EQ $"---------------
 2440         LDX #4
 2450  .12    LDA STRING,X
 2460         JSR COUT
 2470         DEX
 2480         BPL .12
 2490  *---OUTPUT VALUE OF SYMBOL-------
 2500      .DO VERSION     ...V 2.0
 2510         LDX #4
 2520         PLA
 2530         BNE .16      ...PRINT 32-BITS
 2540         DEX
 2550         PLA
 2560         BNE .16      ...PRINT 24-BITS
 2570      .ELSE           ...V 1.1
 2580         LDX #2
 2590      .FIN
 2600         DEX
 2610         PLA
 2620         BNE .16      ...PRINT 24-BITS
 2630         DEX
 2640  .13    PLA
 2650  .16    JSR PRBYTE
 2660         DEX
 2670         BNE .13
 2680  *---APPEND $00 BYTE--------------
 2690         TXA          APPEND $00 BYTE
 2700      .DO VERSION     ...V 2.0
 2710         STA WBUF-4,Y
 2720         DEY
 2730         DEY
 2740      .ELSE           ...V 1.1
 2750         STA WBUF-2,Y
 2760      .FIN
 2770         DEY
 2780         STY WBUF     # BYTES IN LINE
 2790  *---MAKE ROOM IN SOURCE AREA-----
 2800         LDA PRG.BEG
 2810         SEC
 2820         SBC WBUF
 2830         STA PRG.BEG
 2840         BCS .14
 2850         DEC PRG.BEG+1
 2860  *---COPY LINE INTO SOURCE AREA---
 2870  .14    DEY
 2880  .15    LDA WBUF,Y
 2890         STA (PRG.BEG),Y
 2900         DEY
 2910         BPL .15
 2920  *---NEXT SYMBOL FROM CHAIN-------
 2930         INY          Y=0
 2940         LDA (ROOT),Y      FROM THE NUMERIC-ORDER CHAIN
 2950         TAX
 2960         INY
 2970         LDA (ROOT),Y
 2980         STA ROOT+1
 2990         STX ROOT
 3000         BNE .8       ...NOT END OF CHAIN YET
 3010         JSR RENUMBER ...END, SO RENUMBER THE LINES
 3020  .17    JMP SETVID   RESTORE HOOK AND RETURN
 3030  *--------------------------------
 3040  MYCOUT
 3050         AND #$7F
 3060  MYCOUT1
 3070         INY
 3080      .DO VERSION     ...V 2.0
 3090         STA WBUF-5,Y
 3100      .ELSE           ...V 1.1
 3110         STA WBUF-3,Y
 3120      .FIN
 3130         RTS
 3140  *--------------------------------
 3150  STRING .AS "$ QE."
 3160  *--------------------------------
 3170  END

